Un viejo amigo: la práctica se basará en los archivos de datos electorales que se indican a continuación, recopilando datos sobre las elecciones al Congreso de los Diputados en España desde 2008 hasta la actualidad, así como encuestas, códigos de municipios y abreviaturas
abbrev_g<-abbrev |>
mutate(siglas=case_when(
str_detect(denominacion, "PARTIDO SOCIALISTA|PSOE") ~ "PSOE",
str_detect(denominacion, "PARTIDO POPULAR") ~ "PP",
str_detect(denominacion, "CIUDADANOS-PARTIDO DE LA CIUDADANÍA|CIUDADANOS-PARTIDO DE LA CIUDADANIA") ~ "C's",
str_detect(denominacion, "PARTIDO NACIONALISTA VASCO") ~ "PNV",
str_detect(denominacion, "BLOQUE NACIONALISTA GALEGO") ~ "BNG",
str_detect(denominacion, "CONVERGENCIA i UNIO|CONVERGENCIA I UNIO") ~ "CIU",
str_detect(denominacion, "UNIDAS PODEMOS|PODEM|EZKER BATUA|IZQUIERDA UNIDA") ~ "UP",
str_detect(denominacion, "ESQUERRA REPUBLICANA DE CATALUNYA") ~ "ERC",
str_detect(denominacion, "SORTU|EUSKO|ALkARTASUNA|ARALAR|ALTERNATIBA") ~ "EH-BILDU",
str_detect(denominacion, "MÁS PAÍS") ~ "MP",
str_detect(denominacion, "VOX") ~ "VOX",
TRUE ~ "OTROS",
))# Convertir las columnas de fecha a formato Date
surveys_clean <- surveys_tidy |>
mutate(
date_elec = ymd(date_elec),
field_date_from = ymd(field_date_from),
field_date_to = ymd(field_date_to),
field_duration = as.numeric(field_date_to - field_date_from)
)
# Filtrar la base de datos según las condiciones
surveys_clean <- surveys_clean |>
filter(
date_elec >= "2008-01-01",
exit_poll == FALSE,
!is.na(size) & size >= 500,
field_duration > 1
)`
>>>>>>> Stashed changes# Obtener los dos primeros partidos por año
resultados_top2 <- election_tidy_with_siglas |>
filter(censo > 100000) |>
group_by(anno, Partido) |>
summarise(
total_votos = sum(votos, na.rm = TRUE),
.groups = "drop"
) |>
group_by(anno) |>
slice_max(order_by = total_votos, n = 2) |>
arrange(anno, desc(total_votos)) |>
mutate(posicion = row_number()) |>
pivot_wider(
names_from = posicion,
values_from = c(Partido, total_votos)
)
crecimiento_partido <- function(election_tidy) {
# Calcular los votos totales por partido y año
votos_agrupados <- election_tidy |>
group_by(anno, Partido) |>
summarise(total_votos = sum(votos, na.rm = TRUE), .groups = "drop")
# Ordenar los datos por partido y año
votos_ordenados <- votos_agrupados |>
arrange(Partido, anno)
# Calcular el crecimiento o disminución porcentual entre elecciones consecutivas
# Usamos lag() para obtener los votos del año anterior
# En las elecciones en las que un determinado partido aparece por primera vez, el cambio
# porcentual es 0
crecimiento <- votos_ordenados |>
group_by(Partido) |>
mutate(cambio_pct = ifelse(is.na(lag(total_votos)), 0, (total_votos - lag(total_votos)) / lag(total_votos) * 100)) |>
ungroup()
return(crecimiento)
}election_tidy_with_participation <- election_tidy_with_siglas |>
mutate(participacion = votos / censo)
participacion_partido <- election_tidy_with_participation |>
group_by(anno, siglas) |>
summarise(
participacion_media = mean(participacion, na.rm = TRUE),
votos_totales = sum(votos, na.rm = TRUE),
.groups = "drop"
)
resultados_con_participacion <- participacion_partido |>
mutate(resultado_votos = votos_totales / sum(votos_totales) * 100)
colores_partidos <- c(
"PSOE" = "#E30000",
"PP" = "#0000FF",
"C's" = "#FF6600",
"PNV" = "#006747",
"BNG" = "#0C6F6D",
"CIU" = "#9C3D28",
"UP" = "#6A0DAD",
"ERC" = "#E24D3A",
"EH-BILDU" = "#006F6F",
"MP" = "#00CFFF",
"VOX" = "#008000",
"OTROS" = "#BEBEBE"
)
# Crear la gráfica de dispersión con los colores definidos y mejor estética
resultados <- ggplot(resultados_con_participacion, aes(x = participacion_media, y = resultado_votos, color = siglas)) +
geom_point(size = 3, alpha = 0.7) + # Puntos con tamaño ajustado y transparencia
geom_smooth(method = "lm", se = FALSE, aes(group = siglas), color = "black", linetype = "dashed") + # Línea de regresión por partido
facet_wrap(~ anno, scales = "free_y") + # Facetas por año
scale_color_manual(values = colores_partidos) + # Usar los colores definidos
labs(
title = "Relación entre Participación y Resultados Electorales por Año",
subtitle = "Cada punto representa un partido en una elección, con la participación y el porcentaje de votos",
x = "Participación Media (%)",
y = "Porcentaje de Votos (%)",
color = "Partido"
) +
theme_minimal(base_size = 14) + # Estilo minimalista y tamaño de texto ajustado
theme(
legend.position = "bottom", # Colocar la leyenda abajo
legend.title = element_text(face = "bold", size = 12), # Estilo de título de la leyenda
legend.text = element_text(size = 10), # Estilo de texto de la leyenda
strip.text = element_text(face = "bold", size = 12), # Estilo de los títulos de las facetas
plot.title = element_text(face = "bold", size = 16, hjust = 0.5), # Estilo del título
plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
)
resultados_interactivo <- ggplotly(resultados)
resultados_interactivo# Agrupar varios partidos a la misma sigla
surveys_clean_siglas <- surveys_clean |>
mutate(Partido=case_when(
str_detect(Partido, "PSOE") ~ "PSOE",
str_detect(Partido, "PP") ~ "PP",
str_detect(Partido, "C's") ~ "C's",
str_detect(Partido, "PNV") ~ "PNV",
str_detect(Partido, "BNGO") ~ "BNG",
str_detect(Partido, "CIU") ~ "CIU",
str_detect(Partido, "UP") ~ "UP",
str_detect(Partido, "ERC") ~ "ERC",
str_detect(Partido, "EH-BILDU") ~ "EH-BILDU",
str_detect(Partido, "MP") ~ "MP",
str_detect(Partido, "VOX") ~ "VOX",
TRUE ~ "OTROS",
))
# Calcular el porcentaje de votos por partido en las elecciones
votes_percentage <- election_tidy_with_siglas |>
group_by(anno, siglas) |>
summarise(total_votes = sum(votos, na.rm = TRUE), .groups = "drop_last") |>
mutate(percentage_votes = total_votes / sum(total_votes) * 100) |>
ungroup()
# Calcular el porcentaje de intención de voto por partido en las encuestas
survey_percentage <- surveys_clean_siglas |>
mutate(date_elec = year(date_elec)) |>
group_by(date_elec, Partido) |>
summarise(mean_intention = mean(value, na.rm = TRUE), .groups = "drop_last") |>
mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |>
ungroup()
# Unir ambas tablas y calcular el error
error_calibration <- votes_percentage |>
inner_join(survey_percentage, by = c("anno" = "date_elec", "siglas" = "Partido")) |>
mutate(error = abs(percentage_votes - percentage_intention))# Calcular el porcentaje de error por casa encuestadora
media_errors <- surveys_clean_siglas |>
mutate(anno = year(date_elec)) |>
group_by(anno, Partido, media) |>
summarise(
mean_intention = mean(value, na.rm = TRUE),
.groups = "drop"
) |>
mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |>
inner_join(votes_percentage, by = c("anno", "Partido" = "siglas")) |>
mutate(error = abs(percentage_votes - percentage_intention))
# Calcular el error promedio por casa encuestadora
accuracy_by_media <- media_errors |>
group_by(media) |>
summarise(
mean_error = mean(error, na.rm = TRUE),
.groups = "drop"
) |>
arrange(mean_error)
# Identificar las casas encuestadoras más acertadas y más desviadas
medios_mas_acertados <- accuracy_by_media |> slice_min(order_by = mean_error, n = 5)
medios_menos_acertados <- accuracy_by_media |> slice_max(order_by = mean_error, n = 5)##Ejercicios extra Mendoza #Relación entre el censo y el voto mediante un mapa:
>>>>>>> Stashed changesindice <- election_data|>
filter(anno==2019) |>
mutate("key"=glue("{codigo_provincia}-{codigo_municipio}")) |>
drop_na(votos_candidaturas, censo) |>
mutate("indice" = votos_candidaturas / censo)
mapa<-mapSpain::esp_get_munic() |>
mutate("key"=glue("{cpro}-{cmun}"))
mapa_indice<- mapa |>
left_join(indice, by="key")
#Grafico de la participacion
g_ind<-ggplot(mapa_indice)+
geom_sf(aes(alpha=indice, fill=indice), color=NA)+
scale_alpha_continuous(range = c(0.7,0.9))+
scale_fill_gradient2(low = "#b9feff",mid="#00c9ff", high = "#040b64", midpoint =
mean(indice$indice), labels = scales::label_number(scale = 100, suffix="%"))+
labs(fill="PARTICIPACION",
title = "PARTICIPACION 2019")+
theme_minimal()+
theme(
axis.text = element_blank(), # Eliminar etiquetas de los ejes
axis.ticks = element_blank(), # Eliminar marcas de los ejes
legend.position = "bottom", # Colocar la leyenda abajo
legend.title = element_text(face = "bold", size = 12), # Estilo de título de la leyenda
legend.text = element_text(size = 8, angle = 30), # Estilo de texto de la leyenda
strip.text = element_text(face = "bold", size = 12), # Estilo de los títulos de las facetas
plot.title = element_text(face = "bold", size = 12, hjust = 0.5), # Estilo del título
plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
)+
guides(alpha = "none")
#Grafico del censo de España
g_cen<-ggplot(mapa_indice)+
geom_sf(aes(alpha=censo, fill=censo), color=NA)+
scale_alpha_continuous(range = c(0.7,0.9))+
scale_fill_gradient2(low = "#b9feff",mid="#00c9ff", high = "#040b64", midpoint =
mean(election_data$censo), transform = "log",labels = scales::label_number(scale = 1, accuracy = 1))+
labs(title = "CENSO EN 2019")+
theme_minimal()+
theme(
axis.text = element_blank(), # Eliminar etiquetas de los ejes
axis.ticks = element_blank(), # Eliminar marcas de los ejes
legend.position = "bottom", # Colocar la leyenda abajo
legend.title = element_text(face = "bold", size = 12), # Estilo de título de la leyenda
legend.text = element_text(size = 8, angle = 30), # Estilo de texto de la leyenda
strip.text = element_text(face = "bold", size = 12), # Estilo de los títulos de las facetas
plot.title = element_text(face = "bold", size = 12, hjust = 0.5), # Estilo del título
plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
)+
guides(alpha = "none")
votos_censo<-g_ind+g_cen #Sumamos las graficas para compararlas
print(votos_censo) ganadores_mun<-election_tidy_with_siglas |>
filter(anno==2019) |>
mutate("key"=glue("{codigo_provincia}-{codigo_municipio}")) |>
group_by(key) |>
drop_na(votos) |>
slice_max(votos)
ganadores_mun<- ganadores_mun|>
mutate("Tipo_mun"= if_else(censo>median(ganadores_mun$censo),"Urbana","Rural"))
ggplot(ganadores_mun)+
geom_bar(aes(x = siglas, fill = siglas))+
scale_fill_manual(values = colores_partidos)+
facet_wrap(~Tipo_mun)+
labs(title = "GANADORES RURALES Y URBANOS 2019",
x= "PARTIDOS",
y= "VICTORIAS")+
theme_minimal()+
theme(
legend.position = "none", # Quitar la leyenda
strip.text = element_text(face = "bold", size = 12), # Estilo de los títulos de las facetas
plot.title = element_text(face = "bold", size = 12, hjust = 0.5), # Estilo del título
plot.subtitle = element_text(size = 12, hjust = 0.5), # Estilo del subtítulo
axis.text = element_text(size = 10, angle = 30)
)+
guides(alpha = "none")comparativa_partidos <- surveys_clean_siglas |>
mutate(anno = year(date_elec)) |>
group_by(anno, Partido) |>
summarise(
mean_intention = mean(value, na.rm = TRUE),
.groups = "drop"
) |>
mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |>
inner_join(votes_percentage, by = c("anno", "Partido" = "siglas")) |>
mutate(diferencia = percentage_votes - percentage_intention) |>
arrange(desc(diferencia)) |>
slice_max(order_by = diferencia, n = 10)library(mapSpain)
library(ggplot2)
library(dplyr)
election_tidy_with_siglas <- election_tidy_with_siglas |>
mutate(codigo_ccaa = substr(codigo_ccaa, 1, 2))
fragmentacion_ccaa <- election_tidy_with_siglas |>
group_by(codigo_ccaa, Partido) |>
summarise(votos_totales = sum(votos, na.rm = TRUE), censo_total = sum(censo, na.rm = TRUE), .groups = "drop") |>
group_by(codigo_ccaa) |>
reframe(
indice_herfindahl = sum((votos_totales / sum(votos_totales, na.rm = TRUE))^2, na.rm = TRUE),
censo_total = unique(censo_total)
)
mapa_ccaa <- mapSpain::esp_get_ccaa()
mapa_fragmentacion_ccaa <- mapa_ccaa |>
left_join(fragmentacion_ccaa, by = c("codauto" = "codigo_ccaa"))
ggplot(mapa_fragmentacion_ccaa) +
geom_sf(aes(fill = indice_herfindahl), color = "gray90", size = 0.1) +
geom_sf_text(
data = mapa_fragmentacion_ccaa |> filter(!is.na(indice_herfindahl)),
aes(label = sprintf("%.2f", indice_herfindahl)),
size = 2,
color = "black",
fontface = "bold"
) +
scale_fill_gradientn(
colors = c("lightcoral", "gold", "forestgreen"),
name = "Fragmentación",
limits = c(0, 1),
labels = scales::percent_format(accuracy = 1)
) +
labs(
title = "Fragmentación del Voto por Comunidades Autonomas en España",
subtitle = "Índice de Herfindahl",
fill = "Fragmentación (Herfindahl)"
) +
coord_sf(datum = NA) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
legend.position = "right",
legend.title = element_text(size = 10),
legend.text = element_text(size = 8),
panel.grid = element_blank()
)# Rodri
crecimiento_partido <- function(election_tidy) {
# Calcular los votos totales por partido y año
votos_agrupados <- election_tidy |>
group_by(anno, Partido) |>
summarise(total_votos = sum(votos, na.rm = TRUE), .groups = "drop")
# Ordenar los datos por partido y año
votos_ordenados <- votos_agrupados |>
arrange(Partido, anno)
# Calcular el crecimiento o disminución porcentual entre elecciones consecutivas
# Usamos lag() para obtener los votos del año anterior
# En las elecciones en las que un determinado partido aparece por primera vez, el cambio
# porcentual es 0
crecimiento <- votos_ordenados |>
group_by(Partido) |>
mutate(cambio_pct = ifelse(is.na(lag(total_votos)), 0, (total_votos - lag(total_votos)) / lag(total_votos) * 100)) |>
ungroup()
return(crecimiento)
}codigo_a_comunidad <- c(
"14" = "País Vasco",
"07" = "Castilla La Mancha",
"17" = "Comunidad Valenciana",
"01" = "Andalucía",
"08" = "Castilla y León",
"10" = "Extremadura",
"04" = "Islas Baleares",
"09" = "Cataluña",
"11" = "Galicia",
"02" = "Aragón",
"16" = "La Rioja",
"12" = "Madrid",
"15" = "Murcia",
"13" = "Navarra",
"03" = "Asturias",
"05" = "Canarias",
"06" = "Cantabria",
"18" = "Ceuta",
"19" = "Melilla"
)
participacion_media_ccaa <- election_tidy_with_siglas |>
group_by(codigo_ccaa) |>
summarise(
participacion_promedio = mean(votos_candidaturas, na.rm = TRUE) / mean(censo, na.rm = TRUE) * 100
)
participacion_media_ccaa <- participacion_media_ccaa |>
mutate(nombre_ccaa = codigo_a_comunidad[as.character(codigo_ccaa)])
participacion <- ggplot(participacion_media_ccaa, aes(x = reorder(nombre_ccaa, -participacion_promedio), y = participacion_promedio, fill = nombre_ccaa)) +
geom_bar(stat = "identity", show.legend = FALSE, width = 0.8) +
scale_fill_viridis_d(option = "D", begin = 0.2, end = 0.8) +
scale_y_continuous(limits = c(0, 100)) +
labs(
title = "Comunidad Autónoma con Mayor Participación Electoral Promedio (2008-2019)",
subtitle = "Participación promedio en las elecciones durante el período 2008-2019",
x = "Comunidad Autónoma",
y = "Participación Promedio (%)"
) +
theme_minimal(base_size = 15) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1, size = 13, family = "Arial", color = "darkblue"),
axis.text.y = element_text(size = 13, family = "Arial", color = "darkblue"),
axis.title.x = element_text(size = 14, face = "bold", family = "Arial", color = "darkred"),
axis.title.y = element_text(size = 14, face = "bold", family = "Arial", color = "darkred"),
plot.title = element_text(size = 11, face = "bold", family = "Arial", color = "darkgreen"),
plot.subtitle = element_text(size = 12, family = "Arial", color = "gray50"),
plot.margin = margin(10, 20, 10, 20),
panel.grid.major = element_line(color = "gray85", size = 0.5),
panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "white", color = "white"))
participacion_int <- ggplotly(participacion)
participacion_int#¿Cuál es la relación entre la participación electoral y el tamaño de la muestra de las encuestas?
encuestas_filtradas <- surveys_clean_siglas |>
filter(size >= 500)
participacion_por_partido <- encuestas_filtradas |>
group_by(Partido) |>
summarise(mean_participacion = mean(value, na.rm = TRUE))
partidos_colores <- c(
"PSOE" = "#D50032",
"PP" = "#0056A0",
"C's" = "#FF6600",
"VOX" = "#006747",
"UP" = "#9B4F96",
"ERC" = "#D82B6D",
"PNV" = "#006A3E",
"MP" = "#03A9F4",
"EH-BILDU" = "#E32B5F",
"CIU" = "#A7C3A4",
"BNG" = "#E60012",
"Otros" = "#BDBDBD"
)
encuestas <- ggplot(participacion_por_partido, aes(x = reorder(Partido, -mean_participacion), y = mean_participacion, fill = Partido)) +
geom_bar(stat = "identity", width = 0.7) +
scale_fill_manual(values = partidos_colores) +
labs(title = "Participación Electoral Promedio por Partido (Tamaño de Muestra > 500)",
x = "Partido", y = "Participación Electoral Promedio (%)") +
theme_minimal(base_size = 14) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1, size = 12),
axis.text.y = element_text(size = 12),
plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
legend.position = "none",
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()
) +
coord_flip()
encuestas_int <- ggplotly(encuestas)
encuestas_int